Internet Info 1994 March

home *** CD-ROM | disk | FTP | other *** search

/ Internet Info 1994 March / Internet Info CD-ROM (Walnut Creek) (March 1994).iso / networking / terms / kermit / b / vmssys.bli < prev next >

Wrap

Text File | 1991-02-19 | 20.3 KB | 830 lines

MODULE KERSYS (IDENT = '3.3.113', ADDRESSING_MODE(EXTERNAL = GENERAL, NONEXTERNAL = GENERAL) ) = BEGIN !++ ! FACILITY: ! KERMIT-32 ! ! ABSTRACT: ! KERMIT-32 is an implementation of the KERMIT protocal to allow the ! transfer of files from micro computers to the DECsystem-10, DECSYSTEM-20 ! and now the VAX/VMS systems. ! ! ENVIRONMENT: ! User mode ! ! AUTHOR: Robert C. McQueen, Nick Bush, CREATION DATE: 24-January-1983 ! ! MODIFIED BY: ! !-- %SBTTL 'Table of Contents' %SBTTL 'Revision History' !++ ! ! 2.0.032 By: Nick Bush On: 25-Feb-1984 ! Add code for LOCAL and REMOTE commands. These depend ! upon support in KERMSG and KERSYS. ! ! 3.0.045 Start of version 3. ! ! 3.1.057 By: Nick Bush On: 21-Feb-1985 ! Determine VMS version on startup and remember for later ! use. Use it in KERSYS to determine whether we will need ! to force an end-of-file on the mailbox when the subprocess ! on the other end goes away. ! ! 3.1.064 By: Nick Bush On: 30-March-1985 ! Fix LIB$SPAWN call to set SYS$INPUT for the subprocess ! to be NLA0: so that it doesn't try to input from the ! terminal. ! ! 3.1.066 By: Nick Bush On: 22-April-1985 ! Don't use NLA0: as SYS$INPUT when spawning things under VMS 3. ! ! Start of version 3.3 ! ! 3.3.101 By: Robert McQueen On: 2-July-1986 ! Change from $TRNLOG system service calls to LIB$SYS_TRNLOG ! library routine calls. ! ! 3.3.108 By: Antonino N. Mione On: 8-Sep-1986 ! Make KERMIT-32 close the terminal (so the terminal ! parameters are appropriately reset) upon reciept of ! a GENERIC LOGOUT packet. ! ! 3.3.113 JHW0002 Jonathan Welch, 5-May-1988 11:48 ! Modified SY_TIME to use $GETTIM as opposed to the LIB$timer ! routines (which broke when their method of calculating ! time differences changed in V4.4?). ! ! Removed the call to LIB$INIT_TIMER in SY_INIT. !-- %SBTTL 'Include files' ! ! INCLUDE FILES: ! LIBRARY 'SYS$LIBRARY:STARLET'; LIBRARY 'SYS$LIBRARY:TPAMAC'; REQUIRE 'KERCOM'; ! Common definitions REQUIRE 'KERERR'; ! Error message symbol definitions %SBTTL 'Storage -- Local' ! ! OWN STORAGE: ! OWN VMS_VERSION, ! Major version number of VMS ORG_DEFAULT_DIR_TEXT : VECTOR [MAX_FILE_NAME, BYTE], ! Text of default dir ORG_DEFAULT_DIR : BLOCK [8, BYTE], ! Original default directory ORG_DEFAULT_DEV_TEXT : VECTOR [MAX_FILE_NAME, BYTE], ! Text of default device ORG_DEFAULT_DEV : BLOCK [8, BYTE], ! Descriptor for orginal default device Subtrahend : VECTOR [2, LONG]; ! Constant to subtract from system time. !<BLF/FORMAT> %SBTTL 'External routines' ! ! EXTERNAL REFERENCES: ! EXTERNAL ROUTINE ! ! Library routines ! LIB$EDIV : ADDRESSING_MODE (GENERAL), LIB$SET_LOGICAL : ADDRESSING_MODE (GENERAL), LIB$SIGNAL : ADDRESSING_MODE (GENERAL) NOVALUE, LIB$SPAWN : ADDRESSING_MODE (GENERAL), LIB$SUBX : ADDRESSING_MODE (GENERAL), OTS$CVT_L_TZ : ADDRESSING_MODE (GENERAL) NOVALUE, SYS$SETDDIR : ADDRESSING_MODE (GENERAL), SYS$GETTIM : ADDRESSING_MODE (GENERAL), ! ! KERTRM - Terminal handling routines ! TERM_CLOSE, ! Close terminal and restore characteristics ! ! KERTT - Text processing ! TT_INIT : NOVALUE, ! Initialization routine TT_TEXT : NOVALUE, ! Output a text string TT_NUMBER : NOVALUE, ! Output a number TT_CHAR : NOVALUE, ! Output a single character TT_OUTPUT : NOVALUE, ! Routine to dump the current ! text line. TT_CRLF : NOVALUE; ! Output the line %SBTTL 'External storage' ! ! EXTERNAL Storage: ! EXTERNAL ! ! KERMSG storage ! GEN_1DATA : VECTOR [CH$ALLOCATION (MAX_MSG)], ! Data for generic command GEN_1SIZE, ! Size of data in GEN_1DATA GEN_2DATA : VECTOR [CH$ALLOCATION (MAX_MSG)], ! Second argument for generic command GEN_2SIZE, ! Size of data in GEN_2DATA GEN_3DATA : VECTOR [CH$ALLOCATION (MAX_MSG)], ! Third arg for generic command GEN_3SIZE, ! Size of data in GEN_3DATA ! ! Misc constants. ! FILE_SIZE, ! Number of characters in FILE_NAME FILE_NAME : VECTOR [CH$ALLOCATION (MAX_FILE_NAME)]; %SBTTL 'SY_INIT - Initialize KERSYS' GLOBAL ROUTINE SY_INIT : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will initialize the module KERSYS. ! ! CALLING SEQUENCE: ! ! SY_INIT (); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUPTUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! KERSYS storage initialized ! !-- BEGIN LITERAL SYI_EFN = 10; ! EFN to use for $GETSYI LOCAL VERSION_STRING : VECTOR [8, BYTE], ! Return version string here VERSION_LENGTH, ! And length here SYI_ITEM_LIST : BLOCK [16, BYTE], ! Argument list for $GETSYI LENGTH, ! Length of default dir returned STATUS; EXTERNAL ROUTINE LIB$SYS_TRNLOG : ADDRESSING_MODE(GENERAL); ! ! Set up arg list for $GETSYI ! SYI_ITEM_LIST [0, 0, 16, 0] = 8; ! We expect an 8-byte string SYI_ITEM_LIST [2, 0, 16, 0] = SYI$_VERSION; ! Want the VMS version SYI_ITEM_LIST [4, 0, 32, 0] = VERSION_STRING; ! Put it here SYI_ITEM_LIST [8, 0, 32, 0] = VERSION_LENGTH; ! Length goes here SYI_ITEM_LIST [12, 0, 32, 0] = 0; ! End the list STATUS = $GETSYI (EFN=SYI_EFN, ITMLST=SYI_ITEM_LIST); ! Get the data IF NOT .STATUS ! If we can't get the version THEN VMS_VERSION = 0 ! Assume very old VMS? ELSE BEGIN STATUS = $WAITFR (EFN=SYI_EFN); ! Wait for completion IF .STATUS ! If we got it THEN BEGIN IF .VERSION_STRING [0] GEQ %C'0' AND .VERSION_STRING [0] LEQ %C'9' ! If first character is numeric THEN VMS_VERSION = (.VERSION_STRING[0] - %C'0')*10 ! save first digit ELSE VMS_VERSION = 0; ! No first digit, store 0 VMS_VERSION = .VMS_VERSION + .VERSION_STRING[1] - %C'0' ! Get rest of version END ELSE VMS_VERSION = 0; ! Can't get version? END; ! ! Set up original default directory ! ORG_DEFAULT_DIR [DSC$B_CLASS] = DSC$K_CLASS_S; ORG_DEFAULT_DIR [DSC$B_DTYPE] = DSC$K_DTYPE_T; ORG_DEFAULT_DIR [DSC$W_LENGTH] = MAX_FILE_NAME; ORG_DEFAULT_DIR [DSC$A_POINTER] = ORG_DEFAULT_DIR_TEXT; STATUS = SYS$SETDDIR (0, LENGTH, ORG_DEFAULT_DIR); IF .STATUS THEN ORG_DEFAULT_DIR [DSC$W_LENGTH] = .LENGTH ELSE ORG_DEFAULT_DIR [DSC$W_LENGTH] = 0; ! ! Get original default device ! ORG_DEFAULT_DEV [DSC$B_CLASS] = DSC$K_CLASS_S; ORG_DEFAULT_DEV [DSC$B_DTYPE] = DSC$K_DTYPE_T; ORG_DEFAULT_DEV [DSC$W_LENGTH] = MAX_FILE_NAME; ORG_DEFAULT_DEV [DSC$A_POINTER] = ORG_DEFAULT_DEV_TEXT; STATUS = LIB$SYS_TRNLOG (%ASCID'SYS$DISK', LENGTH, ORG_DEFAULT_DEV); IF .STATUS EQL SS$_NOTRAN ! No translation? THEN LENGTH = 0; ! Yes, set the length to zero IF .STATUS THEN ORG_DEFAULT_DEV [DSC$W_LENGTH] = .LENGTH ELSE ORG_DEFAULT_DEV [DSC$W_LENGTH] = 0; END; ! End of SY_INIT %SBTTL 'SY_LOGOUT - delete the process.' GLOBAL ROUTINE SY_LOGOUT : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will delete this process. ! ! CALLING SEQUENCE: ! ! SY_LOGOUT (); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN TERM_CLOSE(); ![108] Close the terminal early $DELPRC (); END; ! End of SY_LOGOUT %SBTTL 'SY_GENERIC - Perform a generic command' GLOBAL ROUTINE SY_GENERIC (GCMD_TYPE, STRING_ADDRESS, STRING_LENGTH, GET_CHR_RTN) = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will perform a generic command. ! ! CALLING SEQUENCE: ! ! SY_GENERIC (GCMD_TYPE, STRING_ADDRESS, STRING_LENGTH, GET_CHR_RTN); ! ! INPUT PARAMETERS: ! ! GCMD_TYPE - GC_xxx value for command to be performed ! STRING_ADDRESS - Place to return address of string result ! STRING_LENGTH - Place to return length of string result ! GET_CHR_RTN - Place to return address of a get a character routine ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! Returns KER_xxx status ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN LITERAL MAX_CMD_LEN = 2*MAX_MSG, ! Max command length MAX_MBX_LEN = 20; ! Max mailbox name length OWN RSP_TEXT : VECTOR [MAX_CMD_LEN, BYTE], ! Return text RSP_LEN; ! Length of return text LOCAL STATUS, ! Status results FLAGS, ! Flag word for LIB$SPAWN OUR_PID, ! Our PID value ITMLST : VECTOR [4, LONG], ! GETJPI argument POINTER, ! Character pointer MBX_CHAN, ! Channel for mail box COMMAND_LENGTH, ! Length of command string COMMAND_DESC : BLOCK [8, BYTE], ! Descriptor for command string COMMAND_STR : VECTOR [MAX_CMD_LEN, BYTE], ! Actual command string MBX_DESC : BLOCK [8, BYTE], ! Mailbox equivalence name MBX_NAME : VECTOR [MAX_MBX_LEN, BYTE]; ! Storage for MBX name ROUTINE PROCESS_COMPLETION_AST (MBX_CHAN) = ! ! This routine is called upon process completion (of the process we spawned ! to perform the command). It will ensure that the mailbox gets an end-of-file. ! BEGIN RETURN $QIO (CHAN = .MBX_CHAN, FUNC = IO$_WRITEOF); ! Write the EOF END; ROUTINE CONCAT (SRC_ADR, SRC_LEN, DST_PTR, DST_LEN) : NOVALUE = ! ! This routine is called to concatenate a string onto the current string ! BEGIN LOCAL LENGTH; ! Length we will actually move LENGTH = .SRC_LEN; ! Get total length IF .LENGTH GTR MAX_CMD_LEN - ..DST_LEN THEN LENGTH = MAX_CMD_LEN - ..DST_LEN; CH$MOVE (.LENGTH, CH$PTR (.SRC_ADR), ..DST_PTR); .DST_PTR = CH$PLUS (.LENGTH, ..DST_PTR); .DST_LEN = ..DST_LEN + .LENGTH; ! Update length END; ! ! Initialize the command descriptor ! COMMAND_DESC [DSC$B_CLASS] = DSC$K_CLASS_S; COMMAND_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T; COMMAND_LENGTH = 0; ! Nothing here yet COMMAND_DESC [DSC$A_POINTER] = COMMAND_STR; ! Point at string storage POINTER = CH$PTR (COMMAND_STR); ! ! Determine what to do with the command ! CASE .GCMD_TYPE FROM GC_MIN TO GC_MAX OF SET [GC_COPY] : BEGIN EXTERNAL GEN_COPY_CMD : BLOCK [8, BYTE]; CONCAT (.GEN_COPY_CMD [DSC$A_POINTER], .GEN_COPY_CMD [DSC$W_LENGTH], POINTER, COMMAND_LENGTH); CONCAT (GEN_1DATA, .GEN_1SIZE, POINTER, COMMAND_LENGTH); CONCAT (UPLIT (%ASCII' '), 1, POINTER, COMMAND_LENGTH); CONCAT (GEN_2DATA, .GEN_2SIZE, POINTER, COMMAND_LENGTH); END; [GC_CONNECT] : BEGIN LOCAL LENGTH, DIR_FAB : $FAB_DECL, ! FAB for $PARSE DIR_NAM : $NAM_DECL, ! NAM for $PARSE EXP_STR : VECTOR [NAM$C_MAXRSS, BYTE], ! Expanded file spec DEV_DESC : BLOCK [8, BYTE], ! Descriptor for device name DIR_DESC : BLOCK [8, BYTE]; DIR_DESC [DSC$B_CLASS] = DSC$K_CLASS_S; DIR_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T; DEV_DESC [DSC$B_CLASS] = DSC$K_CLASS_S; DEV_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T; IF .GEN_1SIZE GTR 0 THEN BEGIN $FAB_INIT (FAB = DIR_FAB, FOP = NAM, NAM = DIR_NAM, FNA = GEN_1DATA, FNS = .GEN_1SIZE); $NAM_INIT (NAM = DIR_NAM, ESA = EXP_STR, ESS = NAM$C_MAXRSS); STATUS = $PARSE (FAB = DIR_FAB); IF NOT .STATUS THEN BEGIN LIB$SIGNAL (.STATUS); RETURN .STATUS; END; IF .DIR_NAM [NAM$B_NODE] GTR 0 THEN BEGIN DEV_DESC [DSC$A_POINTER] = .DIR_NAM [NAM$L_NODE]; DEV_DESC [DSC$W_LENGTH] = .DIR_NAM [NAM$B_NODE] + .DIR_NAM [NAM$B_DEV]; END ELSE BEGIN DEV_DESC [DSC$W_LENGTH] = .DIR_NAM [NAM$B_DEV]; DEV_DESC [DSC$A_POINTER] = .DIR_NAM [NAM$L_DEV]; END; DIR_DESC [DSC$W_LENGTH] = .DIR_NAM [NAM$B_DIR]; DIR_DESC [DSC$A_POINTER] = .DIR_NAM [NAM$L_DIR]; END ELSE BEGIN DIR_DESC [DSC$W_LENGTH] = .ORG_DEFAULT_DIR [DSC$W_LENGTH]; DIR_DESC [DSC$A_POINTER] = .ORG_DEFAULT_DIR [DSC$A_POINTER]; DEV_DESC [DSC$W_LENGTH] = .ORG_DEFAULT_DEV [DSC$W_LENGTH]; DEV_DESC [DSC$A_POINTER] = .ORG_DEFAULT_DEV [DSC$A_POINTER]; END; STATUS = LIB$SET_LOGICAL (%ASCID'SYS$DISK', DEV_DESC); IF NOT .STATUS THEN BEGIN LIB$SIGNAL (.STATUS); RETURN .STATUS; END; STATUS = SYS$SETDDIR (DIR_DESC, 0, 0); IF NOT .STATUS THEN BEGIN LIB$SIGNAL (.STATUS); RETURN .STATUS; END; DIR_DESC [DSC$A_POINTER] = GEN_1DATA; DIR_DESC [DSC$W_LENGTH] = MAX_MSG; STATUS = SYS$SETDDIR (0, DIR_DESC [DSC$W_LENGTH], DIR_DESC); IF NOT .STATUS THEN BEGIN LIB$SIGNAL (.STATUS); RETURN .STATUS; END; POINTER = CH$PTR (RSP_TEXT); RSP_LEN = 0; CONCAT (UPLIT (%ASCII'Default directory set to '), 25, POINTER, RSP_LEN); CONCAT (.DEV_DESC [DSC$A_POINTER], .DEV_DESC [DSC$W_LENGTH], POINTER, RSP_LEN); CONCAT (.DIR_DESC [DSC$A_POINTER], .DIR_DESC [DSC$W_LENGTH], POINTER, RSP_LEN); .STRING_ADDRESS = RSP_TEXT; .STRING_LENGTH = .RSP_LEN; RETURN KER_NORMAL; END; [GC_DELETE] : BEGIN EXTERNAL GEN_DELETE_CMD : BLOCK [8, BYTE]; CONCAT (.GEN_DELETE_CMD [DSC$A_POINTER], .GEN_DELETE_CMD [DSC$W_LENGTH], POINTER, COMMAND_LENGTH); CONCAT (GEN_1DATA, .GEN_1SIZE, POINTER, COMMAND_LENGTH); END; [GC_DIRECTORY] : BEGIN EXTERNAL GEN_DIR_CMD : BLOCK [8, BYTE]; CONCAT (.GEN_DIR_CMD [DSC$A_POINTER], .GEN_DIR_CMD [DSC$W_LENGTH], POINTER, COMMAND_LENGTH); CONCAT (GEN_1DATA, .GEN_1SIZE, POINTER, COMMAND_LENGTH); END; [GC_DISK_USAGE] : BEGIN EXTERNAL GEN_USG_CMD : BLOCK [8, BYTE], ! Command without arg GEN_USG_ARG_CMD : BLOCK [8, BYTE]; ! Command with arg IF .GEN_1SIZE LEQ 0 THEN BEGIN CONCAT (.GEN_USG_CMD [DSC$A_POINTER], .GEN_USG_CMD [DSC$W_LENGTH], POINTER, COMMAND_LENGTH); END ELSE BEGIN CONCAT (.GEN_USG_ARG_CMD [DSC$A_POINTER], .GEN_USG_ARG_CMD [DSC$W_LENGTH], POINTER, COMMAND_LENGTH); CONCAT (GEN_1DATA, .GEN_1SIZE, POINTER, COMMAND_LENGTH); END; END; [GC_HELP] : BEGIN EXTERNAL GEN_HELP_TEXT : BLOCK [8, BYTE]; .STRING_ADDRESS = .GEN_HELP_TEXT [DSC$A_POINTER]; .STRING_LENGTH = .GEN_HELP_TEXT [DSC$W_LENGTH]; RETURN KER_NORMAL; END; [GC_RENAME] : BEGIN EXTERNAL GEN_REN_CMD : BLOCK [8, BYTE]; CONCAT (.GEN_REN_CMD [DSC$A_POINTER], .GEN_REN_CMD [DSC$W_LENGTH], POINTER, COMMAND_LENGTH); CONCAT (GEN_1DATA, .GEN_1SIZE, POINTER, COMMAND_LENGTH); CONCAT (UPLIT (%ASCII' '), 1, POINTER, COMMAND_LENGTH); CONCAT (GEN_2DATA, .GEN_2SIZE, POINTER, COMMAND_LENGTH); END; [GC_SEND_MSG] : BEGIN EXTERNAL GEN_SEND_CMD : BLOCK [8, BYTE]; CONCAT (.GEN_SEND_CMD [DSC$A_POINTER], .GEN_SEND_CMD [DSC$W_LENGTH], POINTER, COMMAND_LENGTH); CONCAT (GEN_1DATA, .GEN_1SIZE, POINTER, COMMAND_LENGTH); CONCAT (UPLIT (%ASCII' "'), 2, POINTER, COMMAND_LENGTH); CONCAT (GEN_2DATA, .GEN_2SIZE, POINTER, COMMAND_LENGTH); CONCAT (UPLIT (%ASCII'"'), 1, POINTER, COMMAND_LENGTH); END; [GC_TYPE] : ! ! While KERMSG handles this for server requests, COMND_LOCAL in KERMIT does ! not. Therefore, set up the request to open the correct file. ! BEGIN CH$COPY (.GEN_1SIZE, GEN_1DATA, CHR_NUL, MAX_FILE_NAME, FILE_NAME); FILE_SIZE = .GEN_1SIZE; RETURN KER_NORMAL; END; [GC_WHO] : BEGIN EXTERNAL GEN_WHO_CMD : BLOCK [8, BYTE]; CONCAT (.GEN_WHO_CMD [DSC$A_POINTER], .GEN_WHO_CMD [DSC$W_LENGTH], POINTER, COMMAND_LENGTH); CONCAT (GEN_1DATA, .GEN_1SIZE, POINTER, COMMAND_LENGTH); CONCAT (GEN_2DATA, .GEN_2SIZE, POINTER, COMMAND_LENGTH); END; [GC_COMMAND] : ! Host command. Just pass it to the process CONCAT (GEN_1DATA, .GEN_1SIZE, POINTER, COMMAND_LENGTH); [INRANGE, OUTRANGE] : BEGIN LIB$SIGNAL (KER_UNIMPLGEN); RETURN KER_UNIMPLGEN; ! We don't do any END; TES; ! ! If we fall out of the case statement, we need to create a mailbox and ! spawn a process to perform the command with its output going to the ! mailbox ! COMMAND_DESC [DSC$W_LENGTH] = .COMMAND_LENGTH; ! Copy command length ITMLST [0] = JPI$_PID^16 + 4; ! Get PID ITMLST [1] = OUR_PID; ! Into OUR_PID ITMLST [2] = ITMLST [2]; ! Get length here ITMLST [3] = 0; ! End of list $GETJPI (ITMLST = ITMLST); ! Get info for us CH$COPY (11, CH$PTR (UPLIT (%ASCII'KERMIT$MBX_')), CHR_NUL, ! Build name MAX_MBX_LEN, CH$PTR (MBX_NAME)); ! for mailbox MBX_DESC [DSC$B_CLASS] = DSC$K_CLASS_S; MBX_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T; MBX_DESC [DSC$W_LENGTH] = MAX_MBX_LEN - 12; ! MBX name length MBX_DESC [DSC$A_POINTER] = MBX_NAME + 11; ! Where to build rest of name OTS$CVT_L_TZ (OUR_PID, MBX_DESC, MAX_MBX_LEN - 12); ! Generate rest of name MBX_DESC [DSC$W_LENGTH] = MAX_MBX_LEN - 1; ! Set total length for create MBX_DESC [DSC$A_POINTER] = MBX_NAME; ! Point at start of name STATUS = $CREMBX (CHAN = MBX_CHAN, LOGNAM = MBX_DESC); IF NOT .STATUS THEN BEGIN LIB$SIGNAL (.STATUS); RETURN .STATUS; END; MBX_NAME [MAX_MBX_LEN - 1] = %C':'; ! Terminate with colon MBX_DESC [DSC$W_LENGTH] = MAX_MBX_LEN; ! Set total length including colon CH$COPY (MAX_MBX_LEN - 1, CH$PTR (MBX_NAME), CHR_NUL, MAX_FILE_NAME, CH$PTR (FILE_NAME)); FILE_SIZE = MAX_MBX_LEN - 1; ! Set up FILE_NAME FLAGS = 1; ! Don't wait for process STATUS = LIB$SPAWN ( ! Spawn a DCL subprocess COMMAND_DESC, ! to do this command (IF .VMS_VERSION LEQ 3 ! If old VMS THEN 0 ! Then no SYS$INPUT arg ELSE %ASCID'NLA0:'), ! no SYS$INPUT MBX_DESC, ! set SYS$OUTPUT to mailbox FLAGS, ! don't wait for process to complete 0, ! Process name 0, ! process id 0, ! completion status 0, ! ? (IF .VMS_VERSION LEQ 3 ! If VMS 3 or earlier THEN PROCESS_COMPLETION_AST ! We need to force eof ELSE ! when process finishes 0), ! 4.0 and on we get one free .MBX_CHAN); ! feed ast routine this value IF NOT .STATUS THEN LIB$SIGNAL (.STATUS); RETURN .STATUS; END; ! End of SY_GENERIC %SBTTL 'SY_DISMISS - Sleep for N seconds' GLOBAL ROUTINE SY_DISMISS (SECONDS) : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine is called to cause KERMIT to sleep for the ! specified number of seconds. ! ! CALLING SEQUENCE: ! ! SY_DISMISS(Number of seconds); ! ! INPUT PARAMETERS: ! ! Number of seconds to sleep. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN LOCAL STATUS, TOTAL_TIME : VECTOR [2, LONG]; ! Quad word for length of time to sleep IF .SECONDS EQL 0 THEN RETURN KER_NORMAL; TOTAL_TIME [0] = -.SECONDS*10*1000*1000; TOTAL_TIME [1] = -1; STATUS = $SETIMR (EFN = 1, DAYTIM = TOTAL_TIME); IF NOT .STATUS THEN LIB$SIGNAL (.STATUS); STATUS = $WAITFR (EFN = 1); IF NOT .STATUS THEN LIB$SIGNAL (.STATUS); END; ! End of SY_DISMISS(time) %SBTTL 'SY_TIME - Return abbreviated system time' GLOBAL ROUTINE SY_TIME = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will return the system time to the calling routine. ! This will allow for the calculation of the effective baud rate. ! ! CALLING SEQUENCE: ! ! TIME = SY_TIME (); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! Time in milliseconds. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN ! ! Local storage ! LOCAL Adjusted_Time : VECTOR [2, LONG], ! System time - a constant. MILLI_SECONDS, ! Time in milliseconds REMAINDER, ! Remainder on EDIV STATUS, ! Status returned by lower level Time : VECTOR [2, LONG], ! Quadword to hold system time. TEN_FOURTH : VECTOR [2, LONG]; ! to hold 10**4 ! ! LIB$EDIV will fail if the system time is too large, so we need ! to subtract some large constant from it - might as well use ! the current time. ! IF .Subtrahend [0] EQL 0 AND .Subtrahend [1] EQL 0 THEN BEGIN STATUS = SYS$GETTIM(Subtrahend); IF NOT .STATUS THEN RETURN 0; END; ! ! Get the VMS system time. ! STATUS = SYS$GETTIM(Time); IF NOT .STATUS THEN RETURN 0; ! ! Compute the longword value from the quadword returned. ! Status = LIB$SUBX(Time, Subtrahend, Adjusted_Time); IF NOT .STATUS THEN RETURN 0; TEN_FOURTH [0] = 1000*10; TEN_FOURTH [1] = 0; STATUS = LIB$EDIV (TEN_FOURTH, Adjusted_Time, MILLI_SECONDS, REMAINDER); IF NOT .STATUS AND .Status NEQ SS$_INTOVF THEN RETURN 0; RETURN .MILLI_SECONDS; END; ! End of SY_TIME %SBTTL 'End of KERSYS.BLI' END ! End of module ELUDOM